perm filename PUB2.SAI[2,TES]2 blob
sn#014748 filedate 1972-11-29 generic text, type T, neo UTF8
00100 BEGIN "PUB2"
00200 REQUIRE 6500 STRING_SPACE ;
00300 COMMENT The Document Compiler -- Pass Two ;
00400 COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
00500 Height Width
00600 For each area:
00700 UpperLine NumCols NumLines
00800 For each column:
00900 LeftChar
01000 For each non-null line: LineNo SHORTM Index of PUInS.PUI line
01100 0
01200 -10
01300
01400 PASS 2 reads the output file name and the intermediate page file names from
01500 PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
01600 each page from each page file, processes each line in each of
01700 its areas, and writes out a line printer image on the output file.
01800
01900 Each line is subject to three operations, in this order:
02000 (1) Substitute label values at each vertical tab.
02100 (2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
02200 (3) Generate underlining and super/sub-scripting as indicated by rubouts.
02300
02400 ;
02500
02600 DEFINE THRU = "STEP 1 UNTIL", DOWN = "STEP -1 UNTIL",
02700 ie = "COMMENT", AWHILE = "WHILE TRUE",
02800 INP(BRKTBL) = "INPUT(SCHAN, BRKTBL)", INNUM = "WORDIN(ICHAN)",
02900 SCN(BRKTBL)="(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))",
03000 SCNUM = "CVD(SCN(TO_ALTMODE_SKIP))",
03100 LPT = "1", TTY = "2", MIC = "3",
03200 HORIZ="'40", VERTI="'41", CSIZE="'42", ULINE="'43", RSPCS="'44",
03300 LSPCS="'45", UDOTS="'46", RDOTS="'47", comment FR80 escape codes ;
03400 FULSTR(X) = "LENGTH(X)", NULSTR(X) = "(LENGTH(X)=0)",
03500 CR = "'15", LF = "'12", VT = "'13", FF = "'14", SP = "'40", BAR = "'30",
03600 RUBOUT = "'177", ALTMODE = "'175", TB = "'11",
03700 TO_ALTMODE_SKIP = "1", TO_LF_APPD = "2",
03800 ONE_CHAR = "3", BREAKER = "4", TO_RUB_ALT_SKIP = "5",
03900 FIML = "256" ;
04000
04100 INTEGER IML, IMC, comment, no. of lines and chars per page image ;
04200 DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
04300 LISTCHAN, comment output file ;
04400 PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
04500 I, J, K, L, M, N, comment general-purpose ;
04600 LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
04700 NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
04800 TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
04900 ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
05000 TOPLINE, NCOLS, NLINES, comment Area info ;
05100 COL, LEFTCH, comment Column info ;
05200 SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
05300 NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
05400 NEEDCR, comment, assures CR before every LF for Stanford LPT ;
05500 LINENO, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
05600 TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;
05700
05800 EXTERNAL INTEGER RPGSW ;
00100 STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S,
00200 OWL, SS, T, ENDLINE, ENDPAGE, DELINT, CRLF ;
00300
00400
00500 REAL RATIO ;
00600
00700 INTEGER ARRAY CHARTBL[0:127], SLIDESG,RB,LBD[1:5] ;
00800
00900 STRING ARRAY LBF[1:5] ;
01000
01100 INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
01200 BEGIN
01300 INTEGER CH ;
01400 CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
01500 LOOKUP(CH, FILENAME, 0) ; RETURN(CH) ;
01600 END "READIN" ;
01700
01800 INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
01900 BEGIN
02000 INTEGER CH ;
02100 CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
02200 ENTER(CH, FILENAME, 0) ; RETURN(CH) ;
02300 END "WRITEON" ;
02400
02500 SIMPLE PROCEDURE WARN(STRING MESSG) ; OUTSTR(MESSG&CR&LF) ;
02600
02700 SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ; WARN("Impossible case index for "&HOW) ;
02800 STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
02900 RETURN('177 & OP & (IF OP≤'42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
03000 STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
03100 STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
03200 STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
03300 STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
03400 STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
03500 STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
03600 STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
03700 STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
03800
03900 PRELOAD_WITH "", " ", " ", " ", " ", " ", " ",
04000 " ", " ", " ", " " ;
04100 SAFE STRING ARRAY SPSARR[0:10] ;
04200
04300 INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ; IF N≤10 THEN RETURN(SPSARR[N MAX 0])
04400 ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
04500 ELSE BEGIN
04600 STRING S ; INTEGER I ;
04700 S ← SPSARR[10] ;
04800 FOR I ← 11 THRU N DO S ← S & SP ;
04900 RETURN(S) ;
05000 END ;
00100 COMMENT I N I T I A L I Z E ;
00200
00300 OUTSTR("P U B P A S S T W O - - -"&CR&LF) ;
00400 IML ← 53 ; IMC ← 69 ; PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
00500 SETBREAK(ONE_CHAR, NULL, NULL, "XA") ;
00600 SETBREAK(TO_ALTMODE_SKIP, ALTMODE, NULL, "IS") ;
00700 SETBREAK(TO_LF_APPD, LF, NULL, "IA") ;
00800 SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
00900 SETBREAK(TO_RUB_ALT_SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
01000 SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
01100 TMPFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01200 LISTFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
01300 DEBUG ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
01400 DEVICE ← CVD(INPUT(SEQCHAN, TO_ALTMODE_SKIP)) ;
01500 IF ¬RPGSW THEN COMMENT STARTED BY ".R PUB2" ;
01600 DO BEGIN
01700 OUTSTR("OUTPUT DEVICE (LPT, TTY, or MIC) = ") ;
01800 S ← INCHWL ;
01900 DEVICE ← IF S="L" THEN 1 ELSE IF S="T" THEN 2 ELSE IF S="M" THEN 3 ELSE 0 ;
02000 END
02100 UNTIL DEVICE ;
02200 IF ¬RPGSW AND DEBUG THEN
02300 IF DEVICE = MIC THEN DEBUG ← 0
02400 ELSE DO BEGIN
02500 OUTSTR("DEBUG INFO IN RIGHT MARGIN? (Y or N) = ") ;
02600 S ← INCHWL ;
02700 DEBUG ← IF S = "Y" THEN -1 ELSE IF S = "N" THEN 0 ELSE 100 ;
02800 END
02900 UNTIL DEBUG < 100 ;
03000 OUTSTR("WRITING PAGE ") ;
03100 DELINT ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
03200 ENDLINE ← LF ; ENDPAGE ← FF ;
03300 CASE DEVICE-1 OF
03400 BEGIN "DEV"
03500 comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
03600 comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
03700 comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
03800 IF DEBUG THEN BEGIN WARN("Won't put Debug info on Microfilm") ;
03900 DEBUG ← FALSE ; END END ;
04000 END "DEV" ;
04100 J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
04200 LABCHAN ← READIN("PULABL.PUI", FALSE, LABBRC, LABEOF) ;
04300 NL ← CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP)) ;
04400 LASL ← 1000 ; comment, last physical line occupied on the page ;
00100 BEGIN "INNER BLOCK"
00200
00300 STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
00400
00500 AWHILE DO
00600 BEGIN "LABEL"
00700 TABLE ← CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP)) ; IF LABEOF THEN DONE ;
00800 LABTAB[TABLE, CVD(INPUT(LABCHAN, TO_ALTMODE_SKIP))] ← INPUT(LABCHAN, TO_ALTMODE_SKIP) ;
00900 END "LABEL" ;
01000
01100
01200 COMMENT G O ! ;
01300 DO comment, This loop is re-entered only if page image grows ;
01400 BEGIN "SIZE"
01500 SAFE STRING ARRAY IMG[1:IML+IML], SEG[0:IMC+IMC], SRCREF[1:IML] ;
01600 SAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML] ;
01700 LABEL CONTINUE ;
01800 INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
01900 BEGIN
02000 INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
02100 L ← LINE ; EXTRA ← LENGTH(S) ;
02200 WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
02250 IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN WARN("TOO MUCH FOR 1 PAGE: " & S)
02275 ELSE L ← AVAIL ;
02300 T ← IMG[L] ; SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
02400 IF LENGTH(T) < HAD+SPACES+EXTRA THEN BEGIN comment no room -- must use concatenate ;
02500 SS ← SPS(SPACES) ; IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
02600 IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞] END
02700 ELSE BEGIN comment there's room in old string -- IDPB into it.;
02800 SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
02900 START_CODE "APPEND" LABEL LOOP1, LOOP2 ;
03000 MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
03100 MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
03200 LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
03300 END "APPEND" ;
03400 END ;
03500 RETURN(LASC[L] ← CHAR + EXTRA) ;
03600 END "APPD" ;
03700
03800 SIMPLE PROCEDURE CTRL(STRING S) ;
03900 BEGIN
04000 CHAR ← APPD(S) - LENGTH(S) ;
04100 LASC[L] ← CHAR ;
04200 FAKE[L] ← FAKE[L] + LENGTH(S) ;
04300 END "CTRL" ;
04400
04500 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
04600 BEGIN
04700 INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
04800 NUMCHARS ← RIGHTCHAR - UNDERLINE ;
04900 IF NUMCHARS > 0 THEN
05000 BEGIN
05100 SAVEHORIZ ← CHORIZ ;
05200 DESCEND ← CCSIZE DIV 4 ;
05300 CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
05400 SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
05500 DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
05600 UNDERLINE ← RIGHTCHAR ;
05700 END ;
05800 END "UNDERSCORE" ;
05900
06000 SIMPLE PROCEDURE CHANGESPACING ;
06100 IF (N←CHRS-CHAR-1)>0 ∧ (K←(J←N*CHORIZ+SHORTM)/N MIN 511)≠CHORIZ THEN
06200 BEGIN
06300 IF UNDERLINE≥0 THEN UNDERSCORE(CHAR) ;
06400 SHORTM ← J - K*N ;
06500 IF NOTFST ∧ (UNDERLINE<0 ∨ SHORTM<0) THEN
06600 BEGIN DORDOTS(SHORTM) ; SHORTM ← 0 END ;
06700 CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
06800 END "CHANGESPACING" ;
06900
07000 SIMPLE PROCEDURE RIGHTBOUND ;
07100 BEGIN COMMENT RIGHT BOUND OF ∞ ;
07200 INTEGER DEST, FILLIN ; STRING FILLER, OLBF ;
07300 IF SLIDETOP < 1 THEN BEGIN IMPOSSIBLE("SLIDETOP1") ; SLIDETOP ← 1 END ;
07400 FILLIN ← (IF LBD[SLIDETOP] < -900 THEN RB[SLIDETOP]-CHRS
07500 ELSE ((RB[SLIDETOP]-CHRS)-LBD[SLIDETOP]) DIV 2) MAX 0 ;
07600 DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
07700 IF FULSTR(OLBF) THEN
07800 BEGIN "NON-BLANKS"
07900 FILLER ← NULL ;
08000 WHILE CHRS < DEST DO
08100 BEGIN
08200 FILLER ← FILLER & OLBF ;
08300 CHRS ← CHRS + LENGTH(OLBF) ;
08400 END ;
08500 IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
08600 SEG[SLIDESG[SLIDETOP]] ← FILLER ;
08700 END "NON-BLANKS"
08800 ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT & "+" & CVS(FILLIN) ;
08900 CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
09000 BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
09100 END ;
00100 IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
00200 AWHILE DO
00300 BEGIN "FILE"
00400 PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ; IF SEQEOF THEN DONE ;
00500 IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
00600 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
00700 AWHILE DO
00800 BEGIN "PAGE"
00900 PAGEHIGH ← INNUM ; IF PAGEEOF ∨ PAGEHIGH≤0 THEN DONE ; PAGEWIDE ← INNUM ;
01000 IF PAGEHIGH > IML ∨ PAGEWIDE > IMC THEN
01100 BEGIN "EXPAND"
01200 IF DEVICE=MIC THEN
01300 BEGIN "FRAME SIZE"
01400 IF LASL ≠ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
01500 NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
01600 NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
01700 OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
01800 END "FRAME SIZE"
01900 ELSE IF DEVICE = LPT THEN
02000 BEGIN
02100 IF (LASL-1) MOD 66 + 1 ≤ 6 ∧ (PAGEHIGH-1) MOD 66 < 60 THEN
02200 OUT(LISTCHAN, ENDPAGE) ;
02300 ENDLINE ← IF PAGEHIGH≥54 THEN RUBOUT & '21 ELSE LF ;
02400 END ;
02500 IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
02600 DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
02700 END "EXPAND" ;
02800 CONTINUE: OUTSTR(CVS(PAGECT ← PAGECT + 1) & SP) ; AVAIL ← IML ;
02900 IF DEVICE = LPT THEN
03000 IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
03100 ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
03200 BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END ;
03300 WHILE (TOPLINE ← INNUM) > -10 DO
03400 BEGIN "AREA"
03500 NCOLS ← INNUM ; NLINES ← INNUM ;
03600 FOR COL ← 1 THRU NCOLS DO
03700 BEGIN "COLUMN"
03800 LEFTCH ← INNUM ;
03900 WHILE (LINENO ← INNUM) DO
04000 BEGIN "LINE"
04100 SH ← SHORTM ← INNUM ; SG ← FSTBRK ← -1 ; BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
04200 LINE ← TOPLINE - 1 + LINENO ;
04300 IF LINE<1∨LINE>IML THEN BEGIN WARN("Area outside page"); LINE←LINE MAX 1 MIN IML END ;
04400 L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
04500 IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
04600 ELSE BEGIN FROMFILE ← TRUE ;
04700 WHILE L ≠ (M←CVD(INP(TO_ALTMODE_SKIP))) DO
04800 BEGIN S ← NULL ;
04900 DO S ← S & INP(TO_LF_APPD) UNTIL PAGEBRC = LF ;
05000 OWLS[M MOD FIML] ← S ;
05100 END ;
05200 END ;
05300 IF ¬DEBUG THEN S ← SCN(TO_ALTMODE_SKIP)
05400 ELSE BEGIN
05500 SRCREF[LINE] ← SRCREF[LINE] & " " & SCN(TO_RUB_ALT_SKIP) ;
05600 WHILE PAGEBRC ≠ ALTMODE DO
05700 BEGIN "ERROR MESSG"
05800 S ← SCN(TO_RUB_ALT_SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
05900 IF DEVICE=TTY ∨ (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SRCREF[L])+M ≤ 119 THEN
06000 SRCREF[L] ← SRCREF[L] & "..." & S ;
06100 END "ERROR MESSG" ;
06200 END ;
06300 DO BEGIN "PIECE"
06400 CHRS ← CHRS + LENGTH(SEG[SG ← SG + 1] ← SCN(BREAKER)) ;
06500 CASE CHARTBL[PAGEBRC] OF
06600 BEGIN comment by BRC ;
06700 ie 0 ... ; IMPOSSIBLE("BREAKER") ;
06800 ie 1 ... RUBOUT -- Font change ; BEGIN
06900 SEG[SG←SG+1] ← RUBOUT & (F←SCN(ONE_CHAR)) &
07000 (S ← IF F="-" ∨ F="+" ∨ F="=" THEN SCN(TO_ALTMODE_SKIP)
07100 ELSE IF F = "π" THEN SCN(ONE_CHAR) ELSE NULL) ;
07200 IF F = "π" THEN CHRS ← CHRS + 1
07300 ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
07400 ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
07500 ELSE IF F = "→" THEN
07600 BEGIN COMMENT ∞ ;
07700 IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN IMPOSSIBLE("SLIDETOP") ;
07800 SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
07900 LBD[SLIDETOP] ← SCNUM ; LBF[SLIDETOP] ← SCN(TO_ALTMODE_SKIP) ;
08000 END
08100 ELSE IF F = "←" THEN
08200 RIGHTBOUND
08300 ELSE IF F = "=" THEN BEGIN BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
08400 END ; COMMENT NOJUST LEFT OF TAB ;
08500 ie 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[SG←SG+1] ← ALTMODE END ;
08600 ie 3 ... VT -- label reference ;
08700 BEGIN "LABEL REF"
08800 L ← LENGTH(SEG[SG←SG+1] ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ) ;
08900 SHORTM ← SHORTM - L ; CHRS ← CHRS + L ;
09000 END "LABEL REF" ;
00100 ie 4 ... CR -- Justify it ;
00200 BEGIN "JUSTIFY"
00300 WHILE SLIDETOP DO BEGIN IMPOSSIBLE("SLIDE TOP") ; RIGHTBOUND END ;
00400 IF SHORTM < 0 THEN SHORTM ← 0 ;
00500 IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ
00600 ELSE BEGIN "DISTRIBUTE SPACES"
00700 COMMENT β(α,K) = [α(K+1)] - [αK],
00800 WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
00900 RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
01000 END "DISTRIBUTE SPACES" ;
01100 UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN IML ; CHAR←LEFTCH-1 MAX 0 ;
01200 NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
01300 IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
01400 FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
01500 BEGIN comment three cases ;
01600 ie 0 ... text ;
01700 BEGIN "TEXT SEG"
01800 CHAR ← APPD(S) ;
01900 IF UNDERLINE≥0 THEN
02000 IF DEVICE = MIC THEN
02100 BEGIN K ← LENGTH(S) ;
02200 WHILE K DO
02300 BEGIN COMMENT DON'T UNDERLINE BLANKS ;
02400 N ← LOP(S) ;
02500 IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
02600 K ← K - 1 ;
02700 END ;
02800 END
02900 ELSE BEGIN K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR←CHAR-K ;
03000 START_CODE "UNDER" LABEL LOOP ;
03100 MOVE 2, K ; MOVE 3, SS ;
03200 LOOP: ILDB 4,3 ; CAIE 4,SP ; MOVEI 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
03300 END "UNDER" ; CHAR ← APPD(SS[1 TO LENGTH(S)]) ;
03400 END ;
03500 END "TEXT SEG" ;
03600 ie 1 ... RUBOUT -- Font Change ;
03700 IF (F←S[2 FOR 1])="↑" THEN
03800 IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE LINE←LINE-1 MAX 1
03900 ELSE IF F = "↓" THEN
04000 IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE LINE←LINE+1 MIN IML
04100 ELSE IF F = "_" THEN UNDERLINE ← CHAR
04200 ELSE IF F = "≡" THEN
04300 BEGIN "END UNDERLINED TEXT"
04400 IF DEVICE = MIC THEN UNDERSCORE(CHAR) ;
04500 UNDERLINE ← -1 ;
04600 END "END UNDERLINED TEXT"
04700 ELSE IF F="-" THEN
04800 IF DEVICE=MIC THEN CTRL(DOLSPCS(CVD(S[3 TO ∞])))
04900 ELSE CHAR←CHAR-CVD(S[3 TO ∞]) MAX 0
05000 ELSE IF F="*" THEN CHAR ← LASC[LINE] comment not always correct! ;
05100 ELSE IF F="+" THEN
05200 IF DEVICE=MIC THEN CTRL(DORSPCS(CVD(S[3 TO ∞])))
05300 ELSE CHAR←CHAR+CVD(S[3 TO ∞]) MIN IMC
05400 ELSE IF F="=" THEN
05500 BEGIN "TAB"
05600 F ← CVD(S[3 TO ∞]) + LEFTCH - 1 MIN IMC MAX 1 ;
05700 IF DEVICE ≠ MIC THEN CHAR ← F
05800 ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
05900 ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
06000 END "TAB"
06100 ELSE IF F = "π" THEN
06200 BEGIN F←S[∞ FOR 1] ;
06300 IF F = "_" THEN CHAR ← APPD(IF DEVICE≠MIC THEN "_" ELSE SP)
06400 ELSE IF DEVICE = TTY THEN CHAR ← APPD(F)
06500 ELSE BEGIN CHAR←APPD(RUBOUT&(
06600 IF F="." THEN '0 ELSE IF F="G" THEN '11 ELSE IF F="∂" THEN '12 ELSE IF F
06700 ="~" THEN '13 ELSE IF F="-" THEN '14 ELSE IF F="+" THEN '15 ELSE 0))-1 ;
06800 LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + 1 ; END ;
06900 IF UNDERLINE≥0 ∧ DEVICE≠MIC THEN BEGIN CHAR←CHAR-1; CHAR←APPD(BAR) END ;
07000 END
07100 ELSE IF F = "←" THEN BEGIN END
07200 ELSE IMPOSSIBLE("FONT `"&F&"'") ;
07300 ie 2 ... ALTMODE -- word break ;
07400 IF SHORTM ∧ G > FSTBRK THEN
07500 IF DEVICE ≠ MIC THEN
07600 BEGIN "SPREAD"
07700 TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
07800 CHAR ← CHAR + TERMX - TERM MIN IMC ;
07900 TERM ← TERMX ;
08000 END "SPREAD"
08100 ELSE CHANGESPACING ;
08200 ie 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
08300 END ; COMMENT three cases ;
08400 IF CHORIZ ≠ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ;
08500 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
08600 END "JUSTIFY" ;
00100 ie 5 ... LF ; BEGIN END ;
00200 END ; comment, by BRC ;
00300 END "PIECE"
00400 UNTIL PAGEBRC = LF ;
00500 END "LINE" ;
00600 END "COLUMN" ;
00700 END "AREA" ;
00800
00900 FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
01000
01100 F ← 120 - (IMC MAX 78) ;
01200 FOR N ← 1 THRU LASL DO
01300 BEGIN "LIST LINE"
01400 L ← N ; IF DEBUG ∧ LENGTH(S←SRCREF[L])>F ∧ DEVICE=LPT THEN S←S[1 TO F] ;
01500 NEEDCR ← TRUE ;
01600 DO BEGIN "PART LINE"
01700 IF M ← LASC[L] THEN
01800 BEGIN "NONBLANK"
01900 OUT(LISTCHAN, IMG[L][1 TO M+FAKE[L]]) ;
02000 IF DEBUG ∧ L=N THEN OUT(LISTCHAN, SPS((IMC MAX 80)-M) & S);
02100 OUT(LISTCHAN, CR) ; NEEDCR ← FALSE ;
02200 END "NONBLANK" ;
02300 M ← L ; L ← LINK[M] ; LINK[M] ← LASC[M] ← FAKE[M] ← 0 ;
02400 END "PART LINE" UNTIL L=0 ;
02500 IF NEEDCR THEN OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
02600 OUT(LISTCHAN, ENDLINE) ;
02700 IF DEBUG THEN SRCREF[N] ← NULL ;
02800 END "LIST LINE" ;
02900
03000 IF DEVICE ≠ LPT THEN OUT(LISTCHAN, ENDPAGE) ;
03100
03200 END "PAGE" ;
03300
03400 IF ¬(PAGEEOF ∨ PAGEHIGH≤0) THEN DONE ; comment expand IMG ;
03500 RELEASE(ICHAN) ; RELEASE(SCHAN) ;
03600 END "FILE" ;
03700
03800 END "SIZE" UNTIL SEQEOF ;
03900
04000 OUT(LISTCHAN, ENDPAGE) ;
04100
04200 RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
04300 END "INNER BLOCK" ;
04400
04500 BEGIN EXTERNAL SIMPLE PROCEDURE K_OUT ; K_OUT END ; COMMENT ** ** ** ** ** ;
04600
04700 OUTSTR("PASS TWO DONE" & CRLF) ;
04800 IF DELINT="A" ∨ DELINT="a" THEN
04900 BEGIN
05000 OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
05100 DELINT ← INCHWL ;
05200 END ;
05300 IF DELINT="Y" ∨ DELINT="y" THEN
05400 BEGIN "DELETE INTERMEDIATE FILES"
05500 SEQCHAN ← READIN("PUPSEQ.PUI", FALSE, SEQBRC, SEQEOF) ;
05600 FOR I ← LISTFILE, DEBUG, DEVICE, DELINT DO INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
05700 LABCHAN ← READIN("PULABL.PUI", FALSE, LABBRC, LABEOF) ;
05800 RENAME(LABCHAN, NULL, 0, I) ; COMMENT DELETE ;
05900 AWHILE DO
06000 BEGIN
06100 PAGEFILE ← INPUT(SEQCHAN, TO_ALTMODE_SKIP) ;
06200 IF SEQEOF THEN DONE ;
06300 IFILE ← PAGEFILE & ".PUI" ; SFILE ← PAGEFILE & "S.PUI" ;
06400 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
06500 SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
06600 RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
06700 END ;
06800 RENAME(SEQCHAN, NULL, 0, I) ;
06900 END "DELETE INTERMEDIATE FILES"
07000 ELSE IF DELINT≠"N" ∧ DELINT≠"n" THEN WARN(DELINT&"? -- .PUI FILES WERE NOT DELETED") ;
07100
07200 IF DEVICE = MIC THEN
07300 BEGIN "PASS 3"
07400 INTEGER FCHAN ;
07500 INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START_CODE MOVE 1, A ; END ;
07600 INTEGER ARRAY PASSTHREE[0:4] ;
07700 FCHAN ← WRITEON("$PUB$.RPG") ;
07800 OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
07900 RELEASE(FCHAN) ;
08000 PASSTHREE[0] ← CVSIX("DSK") ;
08100 PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
08200 PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
08300 OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
08400 CALL(CORELOC(PASSTHREE), "SWAP") ;
08500 END "PASS 3" ;
08600
08700 END "PUB2" ;